home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / Module source / Tool < prev    next >
Encoding:
Text File  |  1993-04-29  |  6.1 KB  |  243 lines  |  [TEXT/ttxt]
  1. \ Construct table of names & traps for toolbox calls
  2. \ Modification History
  3. \  4/23/84  CBD Version 1.0
  4. \ 12/29/85  cdn Improved asmCall to accept upper/lower case
  5. \  6/11/86  cdn Added Mac Plus toolbox calls; generally improved code
  6. \  6/28/86  cdn Added call Pack routines by name
  7. \  7/01/86  ndc Added hash collision resolution
  8. \  8/28/86  cdn Added fcall
  9. \  9/03/86  rfd Modified Tools" for HFS compatability (no reopen)
  10. \  6/16/87    rfl    Added calls for MacII
  11. \  8/28/88    rfl increased collision table to 10 bytes because of
  12. \                confusion with dispospixmap and dispospixpat ETC.
  13. \                Make sure to vary name,trap,parm,pibx, and ctable sizes
  14. \                Also, all traps must be in one text file to be read in
  15. \ 8/31/88    rfl changed allot to reserve to fix error in modulation
  16. \                the second pass must equal the first pass in data errors
  17. \                or else the module code will figure the difference is an addr
  18. \                which must be relocated
  19. \ 9/19/88    rfl    added popupmenu traps
  20. \ 10/07/89    rfl increase to 1000 and 120
  21. \  8/13/90    rfl modify sizes
  22. \ 12/15/90    rfl    moved gtool here
  23. \  2/07/91    rfl    increased globals
  24. \  2/17/91    rfl    modified for use with Michael Hore's 32bit hash routine.
  25. \                collisions are VERY rare.
  26. \  7/02/91    rfl    allow hex values for parms
  27. \ 10/25/91    rfl    fixed occasional bug in hex value code
  28.  
  29. Decimal
  30.  
  31. :Module Tool
  32.  
  33. :CLASS  wArray  <Super  Object  2 <Indexed
  34.  
  35.     :M  AT:        ?idx ^Elem  w@             ;M
  36.     :M  TO:        ?idx ^Elem  w!            ;M
  37.  
  38. ;CLASS
  39.  
  40. :CLASS wordCol  <Super wArray
  41.  
  42.     Int        Size    \ # elements in list
  43.  
  44.     \ ( -- curSize )  Return #elements currently in list
  45.     :M  SIZE:  Get: Size  ;M
  46.  
  47.     \ ( val -- )   Add value to end of list
  48.     :M  ADD:  Get: Size  limit  >=
  49.         classErr" 137  Get: size  To: Self
  50.         1 +: Size   ;M
  51.  
  52.     \ ( val -- ind t  OR f)  Find a value in an OC
  53.     :M  INDEXOF:  0 swap Get: Size  0
  54.         DO i  (^elem) w@
  55.             over = IF 2drop  i 1 1 leave THEN
  56.         LOOP  drop  ;M
  57.  
  58. ;CLASS
  59.  
  60. 1500 ordered-Col Names
  61. 1500 wordCol Traps
  62. 500  wordCol pIdx
  63. 500  wordCol Parms
  64.  
  65. hex
  66. \ ( addr -- hashVal )  hash a  name into a 32-bit word
  67. create HashName 
  68.     2057    w,    \        move.l    (sp),a0
  69.     d1cb    w,    \        adda.l    a3,a0
  70.     7000    w,    \        moveq    #0,d0        \ Result will go to D0
  71.     7400    w,    \        moveq    #0,d2
  72.     1418    w,    \        move.b    (a0)+,d2    \ Count
  73.     c43c007f ,    \        and.b    #127,d2        \ Clear top bit in case it's a name field
  74.     60000008 ,    \        bra        lptest
  75.     ef98    w,    \ loop    rol.l    #7,d0
  76.     1218    w,    \        move.b    (a0)+,d1
  77.     b300    w,    \        eor.b    d1,d0        \ b300
  78.     51cafff8 ,    \ lptest dbra    d2,loop
  79.     08c0001f ,    \        bset    #31,d0
  80.     2e80    w,    \        move.l    d0,(sp)
  81. next,
  82. decimal
  83.  
  84. ( str255 chr -- offs t OR f )
  85. : charOf { adr chr -- }
  86.     0    \ bool
  87.     adr c@ 1+ 1
  88.     DO
  89.         adr i+ c@ chr = IF drop i 1- 1 leave THEN
  90.     LOOP
  91. ;
  92. 0 value pstr
  93. \ ( -- )   Get next word, add if tool name, record parm if applicable
  94. : ToolName { \ addr trap# nhash  -- } 
  95.     0 -> pstr size: traps .d
  96.     @word hex number drop -> trap#
  97.     @word -> addr
  98.     addr ascii , charOf         \ ignore any "," in the name
  99.     IF dup addr + 1+ -> pStr addr c! THEN
  100.     addr HashName -> nhash
  101.     nhash indexOf: names        ( trap# hashval [idx] bool )
  102.     IF   . abort" collison"        \ mark collision item
  103.     ELSE nhash add: names trap# add: traps
  104.     THEN 
  105.     pstr
  106.     IF size: names    1- add: pIdx                    \ now figure parms
  107.         pstr 1+ c@ ascii $ =
  108.         IF pstr 1+ hex ELSE pstr decimal THEN  number drop add: parms decimal
  109.     THEN ;
  110.  
  111.  
  112. \ read toolbox name/trap table and fill arrays
  113. : Tools" { \ radix cecho -- }
  114.     base -> radix  decho -> cecho
  115.     new: loadFile setName: topFile
  116.     openReadOnly: topFile ?error 149
  117.  
  118.         0 moveTo: topFile drop
  119.         query: topFile drop
  120.          BEGIN                    \ read until eof
  121.             tib c@ ascii \ <>    \ skip comments
  122.             IF  ToolName THEN
  123.             query: topFile
  124.         UNTIL
  125.         -echo
  126.  
  127.     remove: loadFile
  128.     radix -> base  cecho -> decho ;
  129.  
  130. \ load the calls into the symbol table
  131. Tools" ::Module source:calls.TOT
  132. forget ToolName    \ dump table generation code
  133.  
  134. CR
  135. size: traps  . ." routine names stored" CR
  136. size: parms . ." with parameters" CR
  137.  
  138. \ ( str255 -- Trap [parm] bool )  Get Trap word for a call index
  139. : @Trap { tStr \ mStr -- } 0 -> mStr
  140.     tStr ascii , charOf                    \ stop short of comma if any
  141.     IF dup tStr c! tStr + 2+ -> mStr THEN
  142.     tStr HashName indexOf: names 0= ?error 150
  143.     dup at: traps                    ( idx trap/flag )
  144.     mStr    \ modifier bits if any
  145.     IF    mStr 4 " REGS"    s= IF $ 0100 or THEN    \ GetTrapAddr
  146.         mStr 5 " ASYNC"    s= IF $ 0400 or THEN    \ device drivers
  147.         mStr 5 " IMMED"    s= IF $ 0200 or THEN    \ control calls
  148.         mStr 3 " SYS"    s= IF $ 0400 or THEN    \ Memory Manager
  149.         mStr 5 " CLEAR"    s= IF $ 0200 or THEN
  150.         mStr 5 " MARKS"    s= IF $ 0400 or THEN    \ String Compares
  151.         mStr 4 " CASE"    s= IF $ 0200 or THEN
  152.     THEN
  153.     swap indexOf: pIdx IF at: parms 1 ELSE 0 THEN    \ call parms if any
  154. ;
  155.  
  156. \ ( addr len -- trap )
  157. : AsmCall
  158.     str255 1+ buf255 c@ >uc
  159.     buf255 @Trap
  160.     IF $ 203c w, , THEN w, ;    \ conditionally move parm into D0
  161.  
  162. \ Trap dispatcher
  163. : Call
  164.     @word @Trap
  165.     State
  166.     IF    IF Compile wLitw w, THEN
  167.         Compile (trap) w,
  168.     ELSE IF makeInt THEN
  169.         trap
  170.     THEN
  171. ; Immediate
  172.  
  173. \ Trap dispatcher for low-level File Manager
  174. : fCall
  175.     @word @Trap
  176.     State
  177.     IF    Compile Lit
  178.         IF ELSE 0 THEN
  179.         w, w, Compile (fdos)
  180.     ELSE IF makeInt THEN
  181.         (fdos)
  182.     THEN
  183. ; Immediate
  184.  
  185.  
  186. \ ************
  187.  
  188. 182 ordered-col gNames
  189. 182 wordCol globals
  190.  
  191.  
  192. \ ( -- )   Get next word, add if global name
  193. : globalName
  194.     size: globals .d
  195.     @word hex number drop            ( global addr )
  196.     @word
  197.     HashName dup indexOf: gNames        ( trap# hashval [idx] bool )
  198.     IF   . abort" collision"        \ mark collision item
  199.     ELSE add: gNames add: globals
  200.     THEN ;
  201.  
  202. \ read toolbox name/trap table and fill arrays
  203. : Tools" { \ radix cecho -- }
  204.     base -> radix  decho -> cecho
  205.     new: loadFile setName: topFile
  206.     openReadOnly: topFile ?error 149
  207.  
  208.         0 moveTo: topFile drop
  209.         query: topFile drop
  210.          BEGIN                    \ read until eof
  211.             tib c@ ascii \ <>    \ skip comments
  212.             IF  globalName THEN 
  213.             query: topFile
  214.         UNTIL
  215.         -echo
  216.  
  217.     remove: loadFile
  218.     radix -> base  cecho -> decho ;
  219.  
  220. \ load the calls into the symbol table
  221. Tools" ::Module source:globals
  222. forget globalName    \ dump table generation code
  223.  
  224. CR
  225. size: globals  . ." routine gNames stored" CR
  226.  
  227. \ ( str255 -- global )  Get global word for a global index
  228. : @global { tStr -- }
  229.     tStr HashName indexOf: gNames 0= ?error 150
  230.     dup ^elem: globals w@                    ( idx trap/flag )
  231.     swap drop ;
  232.  
  233. \ global dispatcher
  234. : global
  235.     @word @global
  236.     state 
  237.     IF  compile lit , 'c -base ,
  238.     ELSE  -base
  239.     THEN 
  240. ; Immediate
  241.  
  242. ;Module
  243.